home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 25 / Cream of the Crop 25.iso / program / fpk65_66.zip / SOURCE / RTL / DOS / ARC.PPI next >
Text File  |  1997-01-30  |  2KB  |  74 lines
  1.  
  2.   procedure Arc(x,y,alpha,beta:Integer;Radius:word);
  3.  
  4.    const i:Array[0..20]of Byte=
  5.        (0,3,0, 2,3,1, 2,1,0, 0,1,1, 0,3,0, 2,3,1, 2,1,0);
  6.  
  7.    var counter,index,ofs : integer;
  8.        xa,ya,xe,ye       : Array[0..2]of Integer;
  9.        xp,yp             : integer;
  10.        xradius,yradius   : word;
  11.        first,ready       : Boolean;
  12.  
  13.    procedure DrawArc(index1,index2,index3:byte);
  14.    var ende,incr:integer;
  15.    begin
  16.      if index3=0 then begin
  17.        counter:=index;
  18.        ende:=0;
  19.        incr:=-4;
  20.      end else begin
  21.        counter:=-4;
  22.        ende:=index-4;
  23.        incr:=4;
  24.      end;
  25.      if first then begin
  26.        repeat
  27.          first:=false;
  28.          counter:=counter+incr;
  29.          xp:=PInteger(BufferMem)[counter+index1];
  30.          yp:=PInteger(BufferMem)[counter+index2];
  31.        until (counter=ende) or
  32.          (((xp=xa[0]) or (xp=xa[1]) or (xp=xa[2])) and
  33.          ((yp=ya[0]) or (yp=ya[1]) or (yp=ya[2])));
  34.          if Counter=Ende then exit else putpixel(xp,yp,aktcolor);
  35.        end;
  36.      repeat
  37.      if (((xp=xe[0]) or (xp=xe[1]) or (xp=xe[2])) and
  38.          ((yp=ye[0]) or (yp=ye[1]) or (yp=ye[2]))) then
  39.          begin
  40.            ready:=true;
  41.            exit;
  42.          end;
  43.        counter:=counter+incr;
  44.        xp:=PInteger(BufferMem)[counter+index1];
  45.        yp:=PInteger(BufferMem)[counter+index2];
  46.        putpixel(xp,yp,aktcolor);
  47.      until counter=Ende;
  48.    end;
  49.  
  50.    begin
  51.      first:=true; ready:=false;
  52.      XRadius:=Radius; YRadius:=Radius;
  53.  
  54.      alpha:=alpha mod 360; beta:=beta mod 360;
  55.      case alpha of
  56.          0.. 89  : ofs:=0;
  57.         90..179  : ofs:=1;
  58.        180..269  : ofs:=2;
  59.        270..359  : ofs:=3;
  60.      end;
  61.      x:=x+aktviewport.x1; y:=y+aktviewport.y1;
  62.      xa[1]:=x+round(sin((alpha+90)*Pi/180) * XRadius);
  63.      ya[1]:=y+round(cos((alpha+90)*Pi/180) * YRadius);
  64.      xe[1]:=x+round(sin((beta+90)*Pi/180) * XRadius);
  65.      ye[1]:=y+round(cos((beta+90)*Pi/180) * YRadius);
  66.      xa[0]:=xa[1]-1; xa[2]:=xa[1]+1; ya[0]:=ya[1]-1; ya[2]:=ya[1]+1;
  67.      xe[0]:=xe[1]-1; xe[2]:=xe[1]+1; ye[0]:=ye[1]-1; ye[2]:=ye[1]+1;
  68.      index:=Calcellipse(x,y,Radius,Radius);
  69.      repeat
  70.        DrawArc(i[ofs*3],i[ofs*3+1],i[ofs*3+2]);
  71.        ofs:=(ofs+1) mod 7;
  72.      until ready;
  73.   end;
  74.